;;########################################################################
;; generic.lsp
;; Copyright (c) 1993-2001 by Forrest W. Young
;; This file contains generic functions for menu items 
;; and guidemap and authoring load-on-demand functions.
;;########################################################################


(setf *mainwindow* (intern (string-upcase "*mainwindow*")))




(defun trace-dialog ()
  (let ((string (string-upcase (get-string-dialog "Trace:"))))
    (when string
          (when (equal (select string 0) #\:) 
                (setf string (select string (iseq 1 (1- (length string))))))
      (eval `(trace ,(intern string :keyword))))))

(defun remove-selection (&optional list)
"Args: (&optional list)
For multivariate or matrix data removes the currently selected variables and observations (multivariate) or matrices (matrix). Ignored for table data."
  (when *current-data*
        (setcd *current-data*)
        (when (not (send *current-data* :ways))
              (let* ((nobs  (send *current-data* :nobs))
                     (nvar  (send *current-data* :nvar))
                     (which-obs-selected
                      (which (mapcar #'equal (repeat 'SELECTED nobs) 
                                     (send *current-data* :obs-states))))
                     (which-vars-selected
                      (which (mapcar #'equal (repeat 'SELECTED nvar) 
                                     (send *current-data* :var-states))))
                     (nmats nil)
                     (which-mats-selected nil)
                     )
                (when (send *current-data* :matrices)
                      (setf nmats (send *current-data* :nmat))
                      (setf which-mats-selected
                            (which (mapcar #'equal (repeat 'SELECTED nmats)
                                      (send *current-data* :mat-states))))
                      )
                (when which-obs-selected
                      (send *obs-window* :point-state 
                            which-obs-selected  'INVISIBLE)
                      (send *obs-window* :redraw)
                      (send *current-data* :obs-states 
                            (send *obs-window* :point-state (iseq nobs))))
                (when which-mats-selected
                      (send *obs-window* :point-state 
                            which-mats-selected  'INVISIBLE)
                      (send *obs-window* :redraw)
                      (send *current-data* :mat-states
                            (send *obs-window* :point-state (iseq nmats))))
                (when which-vars-selected
                      (send *var-window* :point-state
                            which-vars-selected 'INVISIBLE)
                      (send *current-data* :var-states 
                            (send *var-window* :point-state (iseq nvar)))
                      (send *var-window* :redraw))))))

(defun remove-selected-data (&optional list)
  "Alias for remove-selection."
  (remove-selection))

;next six functions moved here from function.lsp by fwy on 09-28-02

(defun new-edit ()
"Args: none
New edit opens the Lisp Editor and creates a new file for editing"
    (system (strcat *default-path* "lspedit.exe")))

(defun reedit-data (&optional (dash *current-datasheet*))
  (if dash (send dash :show-window) (error "There are no previously edited data.")))

(defun show-datasheet (&optional (dash *current-datasheet*))
  (if dash (send dash :show-window) (error "There is no datasheet.")))

(defun show-lispedit ()
  (new-edit))

(defun open-file (&rest args) 
"ARGS: &REST ARGS. Alias for Lisp function OPEN"
	(apply #'open args))

(defun open-edit (&optional file) 
"Args: (&optional file)
Open an editing window containing the file ready for editing by the LispEdit application. If the optional string argument FILE is included, the file is opened, otherwise a dialog is presented to select the file. The string need not end with .lsp.  Returns the file name."
  (let ((dir (get-working-directory))
        (lispedit (strcat *default-path* "lspedit.exe   "))
        (short-filename)
        )
    (when (not file)
          (set-working-directory *open-edit-here-directory*) 
          (setf file (read-file-dialog t))
          (send *workmap* :redraw))
    (when file
          (setf *open-edit-here-directory* (get-working-directory))
          (set-working-directory *open-edit-here-directory*)
          (setf short-filename (pathless-file-namestring file))
          (system (strcat lispedit short-filename)))
    file))

(defun load-edit ()
"Args: none
Loads a Lisp Program, including ViSta Scripts and Examples."
  (let ((f (file-dialog)))
    (send *workmap* :redraw)
    (when f (load f) 
          (when *verbose*
                (format t "; finished loading ~s~%" f)))))

#|Changed this to functions below ... fwy 09-28-02
(defun save-data-as (&optional object)
"Args: none
Saves the data contained in the current object (data-object by default) to a file named in the save file dialog."
  (setcd *current-data*)
  (send *current-data* :save-data))

(defun save-data (&optional name)
"Args: (&optional name)
Saves the data contained in the current object to a file named NAME"
  (cond 
    ((not *user-path*)
     (message-dialog (format nil "Sorry. No User Directory.~%You cannot save data.")))
    (t
     (if name (send *current-object* :save-data name)
         (send *current-object* :save-data)))))

(defun create-data (&rest args)
"Args: (&rest args)
Makes the current object create output data.
Arguments depend on what type of object is current." 
  (if args (apply #'send *current-object* :create-data args)
      (send *current-object* :create-data)))
|#

(defun save-data (&rest args)
  (apply #'save-data-as args))

(defun save-data-as (&rest args)
  (cond
    ((equal @ *current-datasheet*)
     (if (send @ :showing)
         (send @ :save-data-as)
         (send (send @ :data-object) :save-data args)))
    ((equal @ *current-data*)
     (apply #'send *current-data* :save-data args)
     )
    ((equal @ *current-model*)
     (apply #'save-model args)
     )
    ((equal @ *current-datasupervisor*)
     (apply #'send (send @ :datasheet) :save-data-as))
    (t (error "Unknown object type")))
  @)

(defun create-data (&rest args)
  (apply #'create-data-object args))

(defun create-data-object (&rest args)
  (cond
    ((equal @ *current-datasupervisor*)
     (apply #'send (send @ :datasheet) :create-data-object args)
     )
    ((equal @ *current-datasheet*)
     (apply #'send @ :create-data-object args)
     )
    ((equal @ *current-data*)
     (apply #'send @ :create-data args)
     )
    ((equal @ *current-model*)
     (apply #'send @ :create-data args)
     )
    (t (error "Unknown object type")))
  @)
    
(defun delete-datasheet-object ()
  (delete-data-object))

(defun delete-data (&key (dialog t))
"Args: none
Deletes the current data object and all its child objects."
  (send *workmap* :delete-data :dialog dialog))

(defun delete-model ()
"Args: none
Deletes the current model object and all its child objects."
  (send *workmap* :delete-model))


(defun analyze-data ()
"Args: none
Presents a dialog box to choose an analysis method from those that are currently enabled in the analysis menu, and then initiates the choosen analysis method."
  (let* ((menu *analyze-menu*)
         (items (send menu :items))
         (titles (mapcar #'(lambda (item) (send item :title)) items))
         (items (select items 
                        (which (mapcar #'(lambda (title) 
                                           (not (equal "-" title))) 
                                       titles))))
         (titles (mapcar #'(lambda (item) (send item :title)) items))
         (enabled (mapcar #'(lambda (item) (send item :enabled)) items))
         (num-analyses (length (which enabled)))
         (choice))
    (case num-analyses
      (0 (message-dialog "No Analysis is Possible"))
      (1 (setf choice 0))
      (t (setf choice
               (choose-item-dialog "Choose Analysis Method" 
                                     (select titles (which enabled))))))
    (when choice
         (send (select (select items (which enabled)) choice) :do-action))))


(defun transform-data ()
"Args: none
Presents a dialog box to choose an transformation method from those that are currently enabled in the transformation menu, and then initiates the choosen transformation method."
  (let* ((menu *trans-menu*)
         (items (send menu :items))
         (titles (mapcar #'(lambda (item) (send item :title)) items))
         (items (select items 
                        (which (mapcar #'(lambda (title) 
                                           (not (equal "-" title))) 
                                       titles))))
         (titles (mapcar #'(lambda (item) (send item :title)) items))
         (enabled (mapcar #'(lambda (item) (send item :enabled)) items))
         (num-analyses (length (which enabled)))
         (choice))
    (case num-analyses
      (0 (message-dialog "No Transformation is Possible"))
      (1 (setf choice 0))
      (t (setf choice
               (choose-item-dialog "Choose Transformation" 
                                     (select titles (which enabled))))))
    (when choice
         (send (select (select items (which enabled)) choice) :do-action))))

(defun merge-vars (&optional name)
"Args: &optional name
Merges the variables of the current and previous data objects."
  (if name (send current-data :merge-variables name)
      (send current-data :merge-variables)))

(defun merge-variables (&optional name)
"Args: &optional name
Merges the variables of the current and previous data objects as object NAME."
  (if name (send current-data :merge-variables name)
      (send current-data :merge-variables)))

(defun merge-obs (&optional name)
"Args: &optional name
Merges the observations of the current and previous data objects."
  (if name (send current-data :merge-observations name)
      (send current-data :merge-observations)))

(defun merge-observations (&optional name)
"Args: &optional name
Merges the observations of the current and previous data objects."
  (if name (send current-data :merge-observations name)
      (send current-data :merge-observations)))

(defun select-variables (var-name-list)
"Args: VAR-NAME-LIST
Selects variables and displays the selection in the variable window, if open."
  (setcd *current-data*)  
  (send *current-data* :select-variables var-name-list))

(defun select-observations (obs-label-list)
"Args: OBS-LABEL-LIST
Selects observations and displays the selection in the observations window, if open."
  (setcd *current-data*)
  (send  *current-data* :select-observations obs-label-list))

(defun select-all ()
  (setcd *current-data*)
  (select-observations (send *current-data* :labels)))

;added next function fwy4.25
(defun select-matrices (mats-name-list)
"Args: MATS-NAME-LIST
Selects matrices and displays the selection in the mats window, if open."
  (setcd *current-data*)
  (send  *current-data* :select-matrices mats-name-list))



(defun show-workmap () (send *workmap* :gui t))

(defun hide-workmap () (send *workmap* :close))

(defun hide-guidemap () (send *guidemap* :close))

#+macintosh(defun show-xlisp-stat () (send *listener* :show-window))
#-macintosh(defun show-xlisp-stat () )

#+macintosh(defun hide-xlisp-stat () (send *listener* :close))

(defun preferences () (send *vista* :preferences))

(defun toplevel () (top-level))


(defun show-about-these-data (&optional string &key (show t))
  (let ((l (send *help-window* :location))
        (s (send *help-window* :size)))
    (when show (about-these-data string))
    (list s l)))

(defun about-this-model (&optional string &key title (show t))
"Args: &OPTIONAL STRING &KEY TITLE (SHOW t)
If STRING is not nil, changes about information to STRING. If STRING is NIL, does the following: Creates *about-window* (if it doesn't exist) and shows the about information for the current model in *about-window*."
  (if *current-model*
      (send *current-model* :about-this-model string :title title :show show)
      (error-message "There is no current model.")))

(defun about-this-analysis ()
  (let* ((icon (send *workmap* :selected-icon-object))
         (title (send icon :analysis))
         (anal (string-downcase (blanks-to-dashes title)))
         (filename (strcat *help-path* (select anal (iseq (min 8 (length anal)))) ".hlp"))
         )
    (file-to-window filename title *help-window*)))

(defun about-the-analysis ()
    (let* ((menu-help-function-list
            (make-menu-item-help-function-list *analyze-menu*))
           (menu-item-number
            (1+ (position (send *cm* :button-name)
                          (send *vista* :plugins) :test #'equal)))
           )
      (eval (select menu-help-function-list menu-item-number))))

(defun show-varobs ()
"Args: none
Shows both the variable and the observation windows."
  (list-variables)
  (list-observations))

(defun list-var ()
"Args: none
Lists the variable names of the current data object."
  (send *vista* :list-variables)
  t)

(defun list-vars ()
"Args: none
Lists the variable names of the current data object."
  (send *vista* :list-variables)
  t)

(defun list-variables ()
"Args: none
Lists the variable names of the current data object."
  (send *vista* :list-variables)
  t)

(defun list-obs ()
"Args: none
Lists the observation labels of the current data object."
  (send *vista* :list-observations)
  t)

(defun list-observations ()
"Args: none
Lists the observation labels of the current data object."
  (send *vista* :list-observations)
  t)


(defun list-mat ()
"Args: none
Lists the matrix names of the current dissimilarity data object."
  (send *vista* :list-matrices)
  t)

(defun list-mats ()
"Args: none
Lists the matrix names of the current dissimilarity data object."
  (send *vista* :list-matrices)
  t)

(defun list-matrices ()
"Args: none
Lists the variable names of the current dissimilarity data object."
  (send *vista* :list-matrices)
  t)

(defun list-cells ()
"Args: none
Lists the cell names of the current table data object."
  (send *vista* :list-cells)
  t)

(defun close-windows ()
"Args: none
Closes the data object windows."
  (send *var-window* :close)
  (send *obs-window* :close))

(defun interpret-model () 
"Args: none
Provides a model interpretation."
  (send current-model :interpret-model))

;;########################################################################
;;guidemap load-on-demand functions
;;########################################################################

(defun show-guidemap () 
"Args: none
Function to show the guidemap. Uses the Guidance function." 
  (if current-object 
      (let ((current-icon-name 
             (send (select (send *workmap* :icon-list) 
                           (send *workmap* :selected-icon))
                   :slot-value 'proto-name))
            ) 
        (if (or (equal current-icon-name
                       (send dob-icon-proto :slot-value 'proto-name))
                (equal current-icon-name
                       (send dib-icon-proto :slot-value 'proto-name))
                (equal current-icon-name
                       (send tab-icon-proto :slot-value 'proto-name)))
            (guidance "data")
            (guidance "model")))
      (guidance)))
#|
(defun guidance (&optional string name)
  "Args: string
Load-on-demand version of the function which provides guidance. For model guidance STRING is MODEL, DATA for data guidance, APPLET for applet NAME guidance.  Otherwise, general guidance."
;Complete function is in the guidemap file 
  (load (strcat *vista-dir-name* "guidemap"))
        (guidance string name))
|#
(defun author-guidemaps ()
  (let ((choice nil))
    (when *expertmap* 
          (setf choice 
                (= 0 (choose-item-dialog "Author New or Existing GuideMap?" 
                                         '("New GuideMap" "Existing GuideMap") 
                                         :initial 0))))
    (author t :new choice)))

(defun author (&optional (logical nil set) &key new)
"Args: (&optional logical &key new)
Load-on-demand version of the function which enables authoring guidemaps."
;Complete function is in guidemap file.
(when set 
      (load (strcat *vista-dir-name* "guidemap"))
      (load (strcat *vista-dir-name* "author"))
      (author logical))
(when (not set) nil))

(defun read-clipboard ()
"Args: none
Returns the value of the Macintosh clipboard provided it contains a single expression readable by the read function."
  (send *listener* :show-window)
  (read t (send *listener* :paste-from-clip)))

(defun remove-missing-data-rows (dmat &key labels)
"Args: DMAT &key LABELS
DMAT is a multivariate data matrix and LABELS is an optional list of row labels.  Returns a matrix with only the rows of DMAT which have no missing data (missing data are coded as the symbol NIL). If LABELS, then returns a list whose first element is DMAT and second element is a new list of labels with appropriate row labels removed."  
  (let* ((nrows (select (array-dimensions dmat) 0)) 
         (ncols (select (array-dimensions dmat) 1)) (ndataums nil)
         (outdata nil)
         (outmat nil)
         (outlab nil)
         (nok 0)
         )
    (dotimes (i nrows)
             (setf ndatums
                   (length (remove t (map-elements #'equal nil 
                                                   (row dmat i)))))
             (when (= ndatums ncols)
                   (setf nok (1+ nok))
                   (when labels 
                         (setf outlab (combine outlab (select labels i))))
                   (setf outdata (combine outdata (row dmat i))) ))
    (when (> nok 0) (setf outmat (matrix (list nok ncols) (rest outdata)))) 
    (if labels
        (list outmat (rest outlab))
        outmat)))

;;Pedro Valero's version of the previous version. Faster

(defun remove-missing-data-rows (matrix &key labels)
"Args: DMAT &key LABELS
DMAT is a multivariate data matrix and LABELS is an optional list of row labels.  Returns a matrix with only the rows of DMAT which have no missing data (missing data are coded as the symbol NIL). If LABELS, then returns a list whose first element is DMAT and second element is a new list of labels with appropriate row labels removed."  
     (let*((LM (REMOVE-DUPLICATES (COMBINE (LIST-MISSING MATRIX))))
           (MISSING-rows (sort-data (SET-DIFFERENCE (ISEQ (ARRAY-DIMENSION MATRIX 0)) LM))))
       (if labels
           (list (select matrix missing-rows (iseq (array-dimension matrix 1)))
                 (select labels missing-rows))
           (select matrix missing-rows (iseq (array-dimension matrix 1))))))

(defun pretty-print (string)
  (let* ((numchar (length string))
         (numlines (ceiling numchar 50))
         (pretty-string)
         (start 0)
         (finish nil)
         )
    (setf string (strcat " " string))
    (dotimes (i numlines)
             (setf start (position #\  string :start (* i 50))) 
             (setf finish (position #\  string :start
                                    (min numchar (* (1+ i) 50))))
             (when (not finish) (setf finish (1+ numchar))) 
             (setf pretty-string (strcat pretty-string
                           (format nil "~%~a" (subseq string start finish))))
             (when (> finish numchar)  (return)))
    pretty-string))




;(append pretty-string (list (format nil "~%~a" (subseq string start finish))))
(defmeth graph-proto :eval-selection ()) ;fwy 4.28
(defmeth graph-proto :edit-selection ()) ;fwy 4.28

(provide "generic")


#|

(string-to-string-list  "This approach to the role of computers is based on the intelligence augmentation (IA) philosophy of Computer Science: Your computer is a device which should augment your intelligence. It is also based on a Cognitive Science theory for the construction of an environment for data analysis. 

Prof Young and his students, over the course of a 10-year research and development project, have created ViSta, a visual statistics system instantiating Prof. Young's theories concerning visual environments for statistical analysis. 

ViSta is a freely available system that is being used for teaching introductory and multivariate statistics, for data analysis by statistically inexperienced researchers as well as by those who are more advanced, and for advanced research and development in graphical and computational statistics. 

ViSta is based not only on Prof. Young's theory-based approach to data analysis, but also on his 30-year career in computational and graphical statistics. ")

|#